home *** CD-ROM | disk | FTP | other *** search
/ PCDisk Magazine Disks / PCDisk Magazine - Disk 5.img / WINE2.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1984-05-28  |  5.8 KB  |  97 lines
  1. 10  REM WINE DATA 2 Copyright (c) 1984 by Morris Effron
  2. 100  KEY OFF:CLS:WIDTH 80:SCREEN 0,0,0:LOCATE 1,1,0:COLOR 7,0:CLEAR:DEFINT I-L:FOR I=1 TO 10:KEY I,"":NEXT I:DEF SEG=&H40:POKE &H17,PEEK(&H17) AND 223:DEF SEG
  3. 150  WR$="WINE RATINGS MENU":WRU$=STRING$(17,196):REG$="LABELS":REGU$=STRING$(7,196):YR$="YEARS":YRU$=STRING$(5,196):B$="<F1> More Label Information,  <Esc> Return To Main Menu"
  4. 160  RAT$="RATING":RATU$=STRING$(6,196):DRNK$="DRINKABILITY":DRNKU$=STRING$(12,196):ESC%=0:REG.PNT%=1:DIM RGS$(13,12),YRS$(20),RTS$(20,12),DR$(20,12):ON ERROR GOTO 50000
  5. 500  LOCATE 12,34:PRINT"WINEDATA 2":LOCATE 14,30:PRINT"The Wines of Italy":LOCATE 24,26:PRINT"Copyright (1984) PC-Disk.";:GOSUB 40000
  6. 1000  CLS:LOCATE 1,1,0:PRINT CHR$(201);STRING$(78,205);CHR$(187);:FOR I=2 TO 22:LOCATE I,1:PRINT CHR$(186);:LOCATE I,80:PRINT CHR$(186);:NEXT I:LOCATE 23,1:PRINT CHR$(200);STRING$(78,205);CHR$(188);:LOCATE 4,34:PRINT WR$:LOCATE 5,34:PRINT WRU$
  7. 1030  LOCATE 8,34:PRINT "1. By Year":LOCATE 10,34:PRINT "2. By Label":LOCATE 12,34:PRINT "3. Exit Program"
  8. 1040  LOCATE 16,8:PRINT"Select 1, 2, or 3 : ";:LOCATE,,1:GOSUB 5000:IF C%>0 AND C%<4 THEN PRINT MID$(STR$(C%),2);
  9. 1055  LOCATE,,0:IF C%=27 OR C%=3 THEN 60000
  10. 1065  RG.SEL%=1:IF C%=1 THEN 10000
  11. 1080  IF C%=2 THEN 20000
  12. 1090  LOCATE 16,8:PRINT STRING$(30," ");:BEEP:GOTO 1040
  13. 5000  C%=0:CH$=INKEY$:IF CH$=""THEN 5000
  14. 5020  IF LEN(CH$)=1 THEN 5100
  15. 5030  CH$=MID$(CH$,2,1):IF ASC(CH$)=59 THEN C%=4
  16. 5050  IF ASC(CH$)=72 THEN C%=5
  17. 5060  IF ASC(CH$)=80 THEN C%=6
  18. 5070  GOTO 5199
  19. 5100  IF ASC(CH$)=27 THEN C%=27:GOTO 5199
  20. 5105  IF ASC(CH$)<49 OR ASC(CH$)>51 THEN 5199
  21. 5110  C%=ASC(CH$)-48
  22. 5199  RETURN
  23. 6000  LOCATE LN,CL%,1
  24. 6020  N$=INKEY$:IF N$=""THEN 6020
  25. 6030  IF LEN(N$)=1 THEN 6500
  26. 6040  N$=MID$(N$,2,1):IF ASC(N$)<>75 AND ASC(N$)<>77 THEN BEEP:GOTO 6020
  27. 6060  IF ASC(N$)=75 THEN 6200
  28. 6070  IF CL%=FIN%+1 OR QQ%THEN BEEP:GOTO 6020
  29. 6080  CL%=CL%+1:PNT%=PNT%+1:LOCATE LN,CL%:GOTO 6020
  30. 6200  IF CL%=STRT%THEN BEEP:GOTO 6020
  31. 6220  CL%=CL%-1:PNT%=PNT%-1:LOCATE LN,CL%:GOTO 6020
  32. 6500  IF N$<"0"OR N$>"9"THEN 6600
  33. 6510  IF CL%=FIN%+1 THEN BEEP:GOTO 6020
  34. 6520  PRINT N$;:MID$(FLD$,PNT%,1)=N$:IF FL%=1 THEN 6699
  35. 6530  CL%=CL%+1:PNT%=PNT%+1:LOCATE LN,CL%:GOTO 6020
  36. 6600  IF ASC(N$)=13 THEN 6699
  37. 6650  IF ASC(N$)<>27 THEN BEEP:GOTO 6020
  38. 6660  ESC%=-1
  39. 6699  LOCATE,,0:RETURN
  40. 10000  QQ%=0:LOCATE 16,8:PRINT STRING$(30," ")
  41. 10015  FLD$="YYYY":FL%=4:PNT%=1:STRT%=33:FIN%=36:LN=18:CL%=33:LOCATE 18,20:PRINT"Enter year : ";FLD$;:GOSUB 6000:IF ESC%THEN ESC%=0:GOTO 1000
  42. 10050  IF VAL(FLD$)<1961 OR VAL(FLD$)>1981 THEN EMSG$="  Enter year from 1961 to 1981":GOSUB 17000:GOTO 10015
  43. 10070  YR.SEL$=FLD$:FOR I=1 TO 20:IF YR.SEL$=YRS$(I)THEN VINT.SEL%=I:GOTO 10080
  44. 10075  NEXT I:EMSG$="No ratings for that year":GOSUB 17000:GOTO 10015
  45. 10080  CLS:LOCATE 1,1,0:PRINT STRING$(80,219);:FOR I=2 TO 21:LOCATE I,1:PRINT CHR$(219);:LOCATE I,80:PRINT CHR$(219);:NEXT I:LOCATE 22,1:PRINT STRING$(80,219);:LOCATE 2,3:PRINT"YEAR : ";:COLOR 15,0:PRINT YR.SEL$;:COLOR 7,0
  46. 10090  LOCATE 4,10:PRINT REG$;:LOCATE 4,36:PRINT RAT$;:LOCATE 4,63:PRINT DRNK$;:LOCATE 5,10:PRINT REGU$;:LOCATE 5,36:PRINT RATU$;:LOCATE 5,63:PRINT DRNKU$;:FOR J=1 TO 12:YY%=J+5:LOCATE YY%,8:PRINT RGS$(0,J);
  47. 10120  LOCATE YY%,38:IF LEN(RTS$(VINT.SEL%,J))=1 THEN RTS$(VINT.SEL%,J)=" "+RTS$(VINT.SEL%,J)
  48. 10130  PRINT RTS$(VINT.SEL%,J);:LOCATE YY%,69:PRINT DR$(VINT.SEL%,J);:NEXT J:YY%=YY%+2:GOSUB 25000:LOCATE 23,2:PRINT"<";CHR$(24);CHR$(25);">";" Select Label,  ";B$
  49. 10210  LOCATE RG.SEL%+5,8:COLOR 15,0:PRINT RGS$(0,RG.SEL%);:LOCATE RG.SEL%+5,38:PRINT RTS$(VINT.SEL%,RG.SEL%);:LOCATE RG.SEL%+5,69:PRINT DR$(VINT.SEL%,RG.SEL%);:COLOR 7,0
  50. 10220  GOSUB 5000:IF C%=27 THEN 1000
  51. 10240  IF C%=4 THEN 15000
  52. 10250  IF C%<>5 AND C%<>6 THEN BEEP:GOTO 10220
  53. 10260  LOCATE RG.SEL%+5,8:PRINT RGS$(0,RG.SEL%);:LOCATE RG.SEL%+5,38:PRINT RTS$(VINT.SEL%,RG.SEL%);:LOCATE RG.SEL%+5,69:PRINT DR$(VINT.SEL%,RG.SEL%);:SOUND 400,1:FOR I=1 TO 10:NEXT I:IF C%=6 THEN 10300
  54. 10280  IF RG.SEL%=1 THEN RG.SEL%=12 ELSE RG.SEL%=RG.SEL%-1
  55. 10290  GOTO 10210
  56. 10300  IF RG.SEL%=12 THEN RG.SEL%=1 ELSE RG.SEL%=RG.SEL%+1
  57. 10310  GOTO 10210
  58. 15000  CLS:COLOR 7,0:HDR$=" ADDITIONAL REGIONAL INFORMATION -- "+RGS$(0,RG.SEL%)+" ":HDRLN%=80-LEN(HDR$):LFT=HDRLN%/2:RT%=80-(LEN(HDR$)+LFT):LOCATE 1,1:PRINT STRING$(LFT,219);HDR$;STRING$(RT%,219);:FOR I=1 TO 10
  59. 15040  LOCATE I*2+1,1:PRINT RGS$(RG.SEL%,I);:NEXT I:IF QQ%THEN QQ$=" Region " ELSE QQ$=" Year 
  60. 15060  LOCATE 23,22:PRINT"<Esc> Return To Ratings By";QQ$;"Screen";
  61. 15100  GOSUB 5000:IF C%=27 THEN IF QQ%THEN 20100 ELSE 10080
  62. 15120  BEEP:GOTO 15100
  63. 17000  BEEP:LOCATE 18,20:PRINT STRING$(25," ");:LOCATE 18,22:PRINT EMSG$;:SOUND 30000,60:SOUND 30000,1:LOCATE 18,22:PRINT STRING$(50," ");:RETURN
  64. 20000  QQ%=-1:FOR J=1 TO 4:JJ=J+18:LOCATE JJ,5:PRINT STR$(J);") ";RGS$(0,J);:LOCATE JJ,22:PRINT STR$(J+4);") ";RGS$(0,J+4);:LOCATE JJ,52:PRINT STR$(J+8);") ";RGS$(0,J+8);:NEXT J:LOCATE 16,8:PRINT STRING$(30," ")
  65. 20015  FLD$="#":FL%=1:PNT%=1:STRT%=35:FIN%=35:LN=17:CL%=35:LOCATE 17,20:INPUT"Enter region : ",FLD$
  66. 20050  IF VAL(FLD$)<1 OR VAL(FLD$)>12 THEN BEEP:GOTO 20015
  67. 20060  RG.SEL%=VAL(FLD$)
  68. 20100  CLS:LOCATE 1,1,0:PRINT STRING$(80,219);:FOR I=2 TO 20:LOCATE I,1:PRINT CHR$(219);:LOCATE I,80:PRINT CHR$(219);:NEXT I:LOCATE 21,1:PRINT STRING$(80,219);:LOCATE 3,3:PRINT"LABEL : ";:COLOR 15,0:PRINT RGS$(0,RG.SEL%);:COLOR 7,0
  69. 20130  LOCATE 4,2:PRINT STRING$(38,205);CHR$(203);STRING$(39,205);:FOR I=5 TO 16:LOCATE I,40:PRINT CHR$(186);:NEXT I
  70. 20150  LOCATE 5,6:PRINT YR$;:LOCATE 5,14:PRINT RAT$;:LOCATE 5,23:PRINT DRNK$;:LOCATE 5,46:PRINT YR$;:LOCATE 5,54:PRINT RAT$;:LOCATE 5,64:PRINT DRNK$;
  71. 20160  LOCATE 6,6:PRINT YRU$;:LOCATE 6,14:PRINT RATU$;:LOCATE 6,23:PRINT DRNKU$;:LOCATE 6,46:PRINT YRU$;:LOCATE 6,54:PRINT RATU$;:LOCATE 6,64:PRINT DRNKU$;:FOR I=1 TO 10:YY%=I+6:LOCATE YY%,7:PRINT YRS$(I);
  72. 20180  LOCATE YY%,16:IF LEN(RTS$(I,RG.SEL%))=1 THEN RTS$(I,RG.SEL%)=" "+RTS$(I,RG.SEL%)
  73. 20190  PRINT RTS$(I,RG.SEL%);:LOCATE YY%,28:PRINT DR$(I,RG.SEL%);:NEXT I:FOR I=1 TO 10:YY%=I+6:LOCATE YY%,47:PRINT YRS$(I+10);
  74. 20230  LOCATE YY%,56:IF LEN(RTS$(I+10,RG.SEL%))=1 THEN RTS$(I+10,RG.SEL%)=" "+RTS$(I+10,RG.SEL%)
  75. 20240  PRINT RTS$(I+10,RG.SEL%);:LOCATE YY%,69:PRINT DR$(I+10,RG.SEL%);:NEXT I:YY%=18:GOSUB 25000:LOCATE 23,2:PRINT SPACE$(11);B$
  76. 20300  GOSUB 5000:IF C%=27 THEN 1000
  77. 20320  IF C%=4 THEN 15000
  78. 20330  BEEP:GOTO 20300
  79. 25000  LOCATE YY%,4:COLOR 15,0:PRINT"10";:COLOR 7,0:PRINT" The best             ";:COLOR 15,0:PRINT"5";:COLOR 7,0:PRINT" Average    ";:COLOR 15,0:PRINT"A";:COLOR 7,0:PRINT" Can take further aging  ";:COLOR 15,0:PRINT"Y";:COLOR 7,0:PRINT" Lay away";
  80. 25010  LOCATE YY%+1,3:COLOR 15,0:PRINT"8-9";:COLOR 7,0:PRINT" Very fine, superior  ";:COLOR 15,0:PRINT"4";:COLOR 7,0:PRINT" Fair       ";:COLOR 15,0:PRINT"O";:COLOR 7,0:PRINT" May be too old          ";:COLOR 15,0:PRINT"*";:COLOR 7,0:PRINT" No info.";
  81. 25030  LOCATE YY%+2,3:COLOR 15,0:PRINT"6-7";:COLOR 7,0:PRINT" Good, above average ";:COLOR 15,0:PRINT CHR$(25);"4";:COLOR 7,0:PRINT" Poor       ";:COLOR 15,0:PRINT"N";:COLOR 7,0:PRINT" Drink now";:RETURN
  82. 40000  OPEN "I",1,"WINE2.DAT":FOR I=1 TO 12:INPUT#1,RGS$(0,I),COUNT%:FOR J=1 TO COUNT%:INPUT#1,RGS$(I,J):NEXT J,I:FOR I=1 TO 20:INPUT#1,YRS$(I):FOR J=1 TO 12:INPUT#1,RTS$(I,J):INPUT#1,DR$(I,J):NEXT J,I:CLOSE#1:RETURN
  83. 50000  IF ERR<>71 AND ERR<>53 THEN 51000
  84. 50020  IF ERR=71 THEN MSG$="Disk Not Ready
  85. 50030  IF ERR=53 THEN MSG$="File Not Found
  86. 50040  CLS:PRINT"A ";MSG$;" error has occurred.":PRINT"Correct, and press any key to continue, or press <Esc> to exit.
  87. 50060  N$=INKEY$:IF N$=""THEN 50060
  88. 50070  IF ASC(N$)=27 THEN RESUME 60000
  89. 50080  CLOSE:RESUME 100
  90. 51000  IF ERR<>62 THEN 52000
  91. 51010  IF ERR=62 THEN MSG$="Input Past End Error (File:WINE1.DAT corrupted)
  92. 51040  CLS:PRINT"A ";MSG$;" has occured -- Returning to Basic.":RESUME 60010
  93. 52000  CLS:PRINT ERL:PRINT"Error #";ERR;" has occurred -- Returning to Basic.":RESUME 60010
  94. 60000  CLS
  95. 60010  KEY 1,"LIST ":KEY 2,"RUN"+CHR$(13):KEY 3,"LOAD"+CHR$(34):KEY 4,"SAVE"+CHR$(34):KEY 5,"CONT"+CHR$(13):KEY 6,","+CHR$(34)+"LPT1:"+CHR$(34)+CHR$(13):KEY 7,"TRON"+CHR$(13):KEY 8,"TROFF"+CHR$(13):KEY 9,"KEY":KEY 10,"SCREEN 0,0,0"+CHR$(13)
  96. 60020  ON ERROR GOTO 0:KEY ON:END
  97.